COMMENT ⊗   VALID 00023 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	DEFINE MAIN = ⊂ 0 ⊃, SUB = ⊂ 1 ⊃
C00004 00003	SIMPLE ETERNAL PROCEDURE INITIALIZE
C00005 00004	SIMPLE ETERNAL PROCEDURE ENTERBLOCK
C00006 00005	SIMPLE ETERNAL PROCEDURE NAMEBLOCK
C00007 00006	SIMPLE ETERNAL PROCEDURE EXITBLOCK
C00008 00007	SIMPLE ETERNAL PROCEDURE ERR
C00009 00008	SIMPLE ETERNAL PROCEDURE STORVAR
C00011 00009	ETERNAL PROCEDURE BEGFOR
C00012 00010	ETERNAL PROCEDURE BEGMOVE
C00013 00011	ETERNAL PROCEDURE BEGSEARCH
C00014 00012	SIMPLE ETERNAL PROCEDURE PUTIND
C00015 00013	ETERNAL PROCEDURE PUTEXPR
C00016 00014	SIMPLE ETERNAL PROCEDURE PUTINIT
C00017 00015	SIMPLE ETERNAL PROCEDURE PUTSTEP
C00018 00016	SIMPLE ETERNAL PROCEDURE PUTFINAL
C00019 00017	SIMPLE ETERNAL PROCEDURE PUTBODY
C00020 00018	ETERNAL PROCEDURE PUSHSTAT
C00021 00019	SIMPLE ETERNAL PROCEDURE POPSTAT
C00022 00020	SIMPLE ETERNAL PROCEDURE NEXSTAT
C00023 00021	ETERNAL PROCEDURE BEGASS
C00024 00022	SIMPLE ETERNAL PROCEDURE LEFTPART
C00025 00023	SIMPLE ETERNAL PROCEDURE RIGHTPART
C00031 ENDMK
C⊗;
DEFINE MAIN = ⊂ 0 ⊃, SUB = ⊂ 1 ⊃;
DEFINE ETERNAL = ⊂ IFC PROGRAM = MAIN THENC EXTERNAL ELSEC INTERNAL ENDC ⊃;
DEFINE PROCBODY = ⊂ IFC PROGRAM = SUB THENC ⊃;
ETERNAL BOOLEAN DEBUGPARSE;
DEFINE PARSEDEBUG = ⊂ IF DEBUGPARSE THEN OUTSTR ⊃;

define	sfor 	= ⊂ 1 ⊃,
	smove	= ⊂ 2 ⊃,
	ssearch = ⊂ 3 ⊃,
	swhile  = ⊂ 4 ⊃,
	sattach = ⊂ 5 ⊃,
	sass	= ⊂ 6 ⊃;
! etc...;

SIMPLE ETERNAL PROCEDURE INITIALIZE;
PROCBODY BEGIN
	parsedebug(crlf&tab&"Initializing main program");
	currblock ← mainprog ← new_record(block);
!	for i ← 0 step 1 until 63 do
		block:buck[i] ← bucket[i];
	block:code[mainprog]  ← new_record(stmnt);
	END;
ENDC
SIMPLE ETERNAL PROCEDURE ENTERBLOCK;
PROCBODY
	BEGIN
 	remember currblock,currtail in blockenv[blocktop];
	blocktop ← blocktop + 1;
	parsedebug(crlf&tab&"Enter new block level "&cvs(blocktop));
	if blocktop > maxblock then
		error("Blocks nested too deeply");
	currblock ← new_record(block); currtail ← block:code[currblock]
	END;
ENDC;
SIMPLE ETERNAL PROCEDURE NAMEBLOCK;
PROCBODY
	datum(block:name[currblock]) ← datum(entri:name[var0]);
ENDC	
SIMPLE ETERNAL PROCEDURE EXITBLOCK;
PROCBODY
	BEGIN
	parsedebug(crlf&tab&"Exit block level "&cvs(blocktop));
	if blocktop = 0 then
		error("Unexpected END");
	blocktop ← blocktop - 1;
	restore currblock, currtail from blockenv[blocktop]
	END;
ENDC
SIMPLE ETERNAL PROCEDURE ERR;
PROCBODY
	error("SYNTAX ERROR");
ENDC
SIMPLE ETERNAL PROCEDURE STORVAR;
PROCBODY
	BEGIN
	if entri:rtype[var0] ≠ tnondeclared
		∧ entri:blocklevel[var0] = blocktop then
		error("Duplicate declaration: "&datum(entri:name[var0]))
	else
		BEGIN
		string typnam;
		entri:blocklevel[var0] ← blocktop;
		typnam ← datum(entri:name[var1]);
		! TEMPORARY KLUDGE;
		if equ(typnam, "FRAME") then
			entri:rtype[var0]  ← tframe
		else if equ(typnam, "INTEGER") then 
			entri:rtype[var0]  ← tintvar
		else if equ(typnam, "SCALAR") then 
			entri:rtype[var0]  ← trealvar
		END
	END;
ENDC
ETERNAL PROCEDURE BEGFOR;
! BEG FOR SOME UNDERSTANDING FROM THAT HORRIBLE AND HEARTLESS AND HOSTILE AND
NASTY AND BUGGY AND EXHAUSTED AND IRRITABLE AND NONFRENCHSPEAKING AND SAILISH
SAIL COMPILER;
PROCBODY
	BEGIN
	stmnt:stype[currstat] ← sfor;
	stmnt:semantics[currstat] ←  new_record(forr)
	END;
ENDC	
ETERNAL PROCEDURE BEGMOVE;
PROCBODY
	BEGIN
	stmnt:stype[currstat] ← smove;
	stmnt:semantics[currstat] ← new_record(move$)
	END;
ENDC
ETERNAL PROCEDURE BEGSEARCH;
PROCBODY
	BEGIN
	stmnt:stype[currstat] ← ssearch;
	stmnt:semantics[currstat] ← new_record(search$)
	END;
ENDC
SIMPLE ETERNAL PROCEDURE PUTIND;
PROCBODY
	BEGIN
	if entri:rtype[var1] ≠ tintvar then
		error("Illegal type for FOR variable");
	forr:convar[stmnt:semantics[currstat]] ← var1
	END;
ENDC
ETERNAL PROCEDURE PUTEXPR;
PROCBODY
	BEGIN
	currexpr ← NEW_RECORD(exprn);
	exprn:datatype[currexpr] ← entri:rtype[var0];
!	if entri:rtype[var0] = tinteger then
		cell:car[exprn:args[currexpr]] ← entri:val[var0]
	else;
		cell:car[exprn:args[currexpr]] ← var0
	END;
ENDC
SIMPLE ETERNAL PROCEDURE PUTINIT;
PROCBODY
	forr:initial[stmnt:semantics[currstat]] ← currexpr;
ENDC

SIMPLE ETERNAL PROCEDURE PUTSTEP;
PROCBODY
	forr:convar[stmnt:semantics[currstat]] ← currexpr;
ENDC

SIMPLE ETERNAL PROCEDURE PUTFINAL;
PROCBODY
	forr:final[stmnt:semantics[currstat]] ← currexpr;
ENDC
SIMPLE ETERNAL PROCEDURE PUTBODY;
PROCBODY
	forr:body[stmnt:semantics[currstat]] ← oldcurrstat;
ENDC
ETERNAL PROCEDURE PUSHSTAT;
PROCBODY
	BEGIN
	remember currstat in statenv[stattop];
	stattop ← stattop + 1;
	if stattop > maxstat then
		error("Statements nested too deeply");
	currstat ← new_record(stmnt)
	END;
ENDC
SIMPLE ETERNAL PROCEDURE POPSTAT;
PROCBODY
	BEGIN
	stattop ← stattop - 1; if stattop < 0 then
		error("Statement stack underflow");
	oldcurrstat ← currstat;
	restore currstat from statenv[stattop]
	END;
ENDC
SIMPLE ETERNAL PROCEDURE NEXSTAT;
PROCBODY
	BEGIN
	currtail ← cell:cdr[currtail] ← new_record(cell);
	currstat ← cell:car[currtail] ← new_record(stmnt)
	END;
ENDC
ETERNAL PROCEDURE BEGASS;
PROCBODY
	BEGIN
	stmnt:stype[currstat] ← sass;
	stmnt:semantics[currstat] ← new_record(assign)
	END;
ENDC
SIMPLE ETERNAL PROCEDURE LEFTPART;
PROCBODY
	assign:var[stmnt:semantics[currstat]] ← var1;
ENDC
SIMPLE ETERNAL PROCEDURE RIGHTPART;
PROCBODY
	assign:val[stmnt:semantics[currstat]] ← currexpr;
ENDC